home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
ROCKSVGA.ZIP
/
ROCKSVGA.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-01-10
|
36KB
|
1,093 lines
{
XXXXXX XXXX XXXXX XX XX XXXXX by
XX XX XX XX XX XX XX XX Paul H. Kahler
XXXXX XX XX XX XXXX XXXX 1993
XX XX XX XX XX XX XX XX
XX XX XXXX XXXXX XX XX XXXXX email: phkahler@oakland.edu
}
{ I am releasing this source code because of numerous requests. }
{ it was never meant to be seen by anyone, as it was thrown }
Program Rocks; { together in my spare time and is lacking style. }
uses { The game is good though :) }
Crt, Dos, Graph, KeyBoard;
Type Number = array[1..7] of byte;
var
GraphDriver : integer; { The Graphics device driver }
GraphMode : integer; { The Graphics mode value }
MaxX, MaxY : word; { The maximum resolution of the screen }
ErrorCode : integer; { Reports any graphics errors }
MaxColor : word; { The maximum color value available }
OldExitProc : Pointer; { Saves exit procedure address }
KBD : keyboardObj;
flicker : word;
boom : integer;
snd,time : integer;
freq :real;
prvs,soundflag:boolean;
maxships,rotleft,rotright,fire,thrust,hyper,plop,newgame:byte;
Ex,Edx,Ey,Edy,Ecount,Etype:integer;
{$F+}
VAR
bl,br:array[0..70] of integer;
ml,mr:array[0..40] of integer;
sl,sr:array[0..20] of integer;
bsl,bsr:array[0..20] of integer;
smsl,smsr:array[0..10] of integer;
numrocks,RocksLeft :integer;
NoShip,Color :boolean;
ssin,scos:real;
score,high:number;
shipsleft:integer;
dustx,dusty,dustcount: array[0..63] of integer;
numd:integer;
procedure INITIALIZE; { This is right out of the book. }
var { Starts up graphics mode }
Graphdriver:integer;
Graphmode:integer;
ErrorCode:integer;
begin
Graphdriver:=VGA;
Graphmode:=VGAhi;
Initgraph(GraphDriver, Graphmode, '');
ErrorCode:=GraphResult;
if errorcode <> grOk then begin
writeln('Graphics error: ',GraphErrorMsg(ErrorCode));
Writeln('Program aborted...');
readln;
Halt(1);
end;
end;
Procedure DrawLetter(l:char; h,v:integer); { Displays a letter }
begin
case l of
'a':begin moveto(h,v+20);lineto(h,v+5);lineto(h+3,v);lineto(h+7,v);
lineto(h+10,v+5);lineto(h+10,v+20);moveto(h,v+12);
lineto(h+10,v+12);end;
'b':begin moveto(h+8,v+10);lineto(h+10,v+12);lineto(h+10,v+18);
lineto(h+8,v+20);lineto(h,v+20);lineto(h,v);lineto(h+8,v);
lineto(h+10,v+2);lineto(h+10,v+8);lineto(h+8,v+10);
lineto(h,v+10);end;
'c':begin moveto(h+10,v);lineto(h+3,v);lineto(h,v+3);lineto(h,v+17);
lineto(h+3,v+20);lineto(h+10,v+20);end;
'd':begin moveto(h,v);lineto(h+6,v);lineto(h+10,v+4);lineto(h+10,v+16);
lineto(h+6,v+20);lineto(h,v+20);lineto(h,v);end;
'e':begin moveto(h+10,v);lineto(h,v);lineto(h,v+20);lineto(h+10,v+20);
moveto(h,v+10);lineto(h+7,v+10);end;
'f':begin moveto(h+10,v);lineto(h,v);lineto(h,v+20);moveto(h,v+10);
lineto(h+7,v+10);end;
'g':begin moveto(h+10,v);lineto(h,v);lineto(h,v+20);lineto(h+10,v+20);
lineto(h+10,v+10);lineto(h+5,v+10);end;
'h':begin moveto(h,v);lineto(h,v+20);moveto(h+10,v);lineto(h+10,v+20);
moveto(h,v+10);lineto(h+10,v+10);end;
'i':begin moveto(h,v);lineto(h+10,v);moveto(h+5,v);lineto(h+5,v+20);
moveto(h,v+20);lineto(h+10,v+20);end;
'j':begin moveto(h+10,v);lineto(h+10,v+20);lineto(h,v+20);
lineto(h,v+15);end;
'k':begin moveto(h,v);lineto(h,v+20);moveto(h,v+10);lineto(h+5,v+10);
lineto(h+10,v);moveto(h+5,v+10);lineto(h+10,v+20);end;
'l':begin moveto(h,v);lineto(h,v+20);lineto(h+10,v+20);end;
'm':begin moveto(h,v+20);lineto(h,v);lineto(h+5,v+10);lineto(h+10,v);
lineto(h+10,v+20);end;
'n':begin moveto(h,v+20);lineto(h,v);lineto(h+10,v+20);lineto(h+10,v);end;
'o':begin moveto(h,v);lineto(h+10,v);lineto(h+10,v+20);lineto(h,v+20);
lineto(h,v);end;
'p':begin moveto(h,v+20);lineto(h,v);lineto(h+10,v);lineto(h+10,v+10);
lineto(h,v+10);end;
'q':begin moveto(h,v);lineto(h+10,v);lineto(h+10,v+12);lineto(h+5,v+20);
lineto(h,v+20);lineto(h,v);moveto(h+6,v+12);lineto(h+10,v+20);
end;
'r':begin moveto(h,v+20);lineto(h,v);lineto(h+10,v);lineto(h+10,v+10);
lineto(h,v+10);moveto(h+5,v+10);lineto(h+10,v+20);end;
's':begin moveto(h+10,v);lineto(h,v);lineto(h,v+10);lineto(h+10,v+10);
lineto(h+10,v+20);lineto(h,v+20);end;
't':begin moveto(h,v);lineto(h+10,v);moveto(h+5,v);lineto(h+5,v+20);end;
'u':begin moveto(h,v);lineto(h,v+20);lineto(h+10,v+20);lineto(h+10,v);end;
'v':begin moveto(h,v);lineto(h+5,v+20);moveto(h+10,v);lineto(h+5,v+20);end;
'w':begin moveto(h,v);lineto(h,v+20);lineto(h+5,v+10);lineto(h+10,v+20);
lineto(h+10,v);end;
'x':begin moveto(h,v);lineto(h+10,v+20);moveto(h+10,v);lineto(h,v+20);end;
'y':begin moveto(h+5,v+20);lineto(h+5,v+10);lineto(h,v);moveto(h+5,v+10);
lineto(h+10,v);end;
'z':begin moveto(h,v);lineto(h+10,v);lineto(h,v+20);lineto(h+10,v+20);end;
end;
end;
Procedure DisplayString(s:string; i,j:integer); { Displays a string }
var c:integer; { at i,j }
begin
for c:=1 to length(s) do
DrawLetter(s[c],i-14+c*14,j);
end;
Procedure LoadTables; { loads the collision tables }
var a,i,j:integer;
f:text;
begin
assign(f,'Colision.tbl');
reset(f);
for a:=0 to 70 do begin {read big rock colision table}
readln(f,i,j);
bl[a]:=i;br[a]:=j;
end;
for a:=0 to 40 do begin {read medium rock colision table}
readln(f,i,j);
ml[a]:=i;mr[a]:=j;
end;
for a:=0 to 20 do begin {read small rock colision table}
readln(f,i,j);
sl[a]:=i;sr[a]:=j;
end;
for a:=0 to 20 do begin {read big ship colision table}
readln(f,i,j);
bsl[a]:=i;bsr[a]:=j;
end;
for a:=0 to 10 do begin {read small ship colision table}
readln(f,i,j);
smsl[a]:=i;smsr[a]:=j;
end;
close(f);
end;
procedure SetRGB(c,r,g,b : byte); { Set the VGA palette registers }
begin
port[$03c8]:=c;
port[$03c9]:=r;
port[$03c9]:=g;
port[$03c9]:=b;
end;
Procedure SetPalette; { sets the 10 colors used by rocks }
begin
SetRGB(0,0,0,0);SetRGB(15,63,63,63);
SetRGB(1,10,10,63);SetRGB(2,63,0,63);
SetRGB(3,0,63,10);SetRGB(4,63,63,0);
SetRGB(5,0,63,50);SetRGB(6,63,10,10);
SetRGB(7,63,0,32);SetRGB(8,63,32,0);
end;
Procedure MoveDust; { Moves the little explosion particles }
var i:integer;
begin
for i:=0 to 63 do begin
if dustcount[i]<20 then begin
setcolor(0);
putpixel(dustx[i],dusty[i],0);
dustx[i]:=dustx[i]+(i and 1)*2-1;
dusty[i]:=dusty[i]+(i and 2)-1;
dustcount[i]:=dustcount[i]+1;
if dustcount[i]<20 then begin
setcolor(15); putpixel(dustx[i],dusty[i],15); end;
end;
end;
end;
Procedure MakeDust(x,y:integer); { Creates an explosion }
begin
dustx[numd]:=x-4;dusty[numd]:=y;dustcount[numd]:=0;
dustx[numd+1]:=x+6;dusty[numd+1]:=y;dustcount[numd+1]:=0;
dustx[numd+2]:=x-4;dusty[numd+2]:=y;dustcount[numd+2]:=0;
dustx[numd+3]:=x+6;dusty[numd+3]:=y;dustcount[numd+3]:=0;
dustx[numd+4]:=x;dusty[numd+4]:=y-6;dustcount[numd+4]:=0;
dustx[numd+5]:=x;dusty[numd+5]:=y-4;dustcount[numd+5]:=0;
dustx[numd+6]:=x;dusty[numd+6]:=y+6;dustcount[numd+6]:=0;
dustx[numd+7]:=x;dusty[numd+7]:=y+4;dustcount[numd+7]:=0;
numd:=(numd+8) and 63;
end;
Procedure DrawEnemy(size,x,y:integer); { Draws the enemy ship }
begin
case size of
1:begin
moveto(x-20,y-1);lineto(x+20,y-1);lineto(x+12,y+10);
lineto(x-12,y+10);lineto(x-20,y-1);
moveto(x-12,y-1);lineto(x-5,y-10);lineto(x+5,y-10);
lineto(x+12,y-1);
end;
2:begin
moveto(x-10,y-1);lineto(x+10,y-1);lineto(x+6,y+5);
lineto(x-6,y+5);lineto(x-10,y-1);moveto(x-6,y-1);
lineto(x-2,y-5);lineto(x+2,y-5);lineto(x+6,y-1);
end;
end;
end;
procedure DrawObject(obtype,x,y:integer); { Draws an asteroid }
begin
case obtype of
1:begin
MoveTo(x-25,y-18);
lineTo(x,y-35); lineto(x+15,y-20); lineto(x+25,y-22);
lineto(x+29,y); lineto(x+20,y+15); lineto(x+25,y+25);
lineto(x+10,y+35); lineto(x-18,y+32); lineto(x-20,y+20);
lineto(x-29,y+5); lineto(x-25,y-18);
end;
2:begin
MoveTo(x,y-20); lineto(x+10,y-15);
lineTo(x+5,y-5); lineto(x+13,y-5);
lineto(x+20,y+5); lineto(x+5,y+20);
lineto(x-15,y+15); lineto(x-20,y);
lineto(x-10,y-15); lineto(x,y-20);
end;
3:begin
Moveto(x,y-10); lineto(x+7,y-5);
lineto(x+10,y+5); lineto(x+3,y+10);
lineto(x-8,y+8); lineto(x-10,y);
lineto(x-5,y-10); lineto(x,y-10);
end;
end;
end;
procedure rotmove(i,j,x,y,s,c:real); { like 'move' but with rotation }
var h,v:real;
begin
moveto(round(i+c*x+s*y),round(j+s*x-c*y));
end;
procedure rotline(i,j,x,y,s,c:real); { like 'line' but with rotation }
var h,v:real;
begin
lineto(round(i+c*x+s*y),round(j+s*x-c*y));
end;
Procedure DrawShip(x,y,flame:real); { Draws the players ship }
VAR s,c,h,v,ex:real;
begin
s:=-ssin; c:=scos;
if boom=0 then begin
rotmove(x,y,-10,10,s,c);
rotline(x,y,18,0,s,c); rotline(x,y,-10,-10,s,c);
rotline(x,y,-8,-8,s,c); rotline(x,y,-6,-4,s,c);
rotline(x,y,-5,0,s,c); rotline(x,y,-6,4,s,c);
rotline(x,y,-8,8,s,c); rotline(x,y,-10,10,s,c);
if (flame>0) and (flicker>0) then begin
rotmove(x,y,-7,5,s,c);
rotline(x,y,-10-flame,0,s,c);
rotline(x,y,-7,-5,s,c);
end;
flicker:= (flicker+1) and 3;
end
else begin { Draws the players ship exploding }
ex:=boom/10;
rotmove(x,y,-10+ex,-10+ex,s,c);rotline(x,y,-8+ex,-7+ex,s,c);
rotmove(x,y,-10-ex,10-ex,s,c);rotline(x,y,-8-ex*1.01,7-ex,s,c);
rotmove(x,y,-7+ex*2,7-ex,s,c);rotline(x,y,-7+ex*1.8,-7+ex,s,c);
rotmove(x,y,-10,10+ex,s,c);rotline(x,y,4,5+ex*1.5,s,c);
rotmove(x,y,4+ex,5+ex,s,c);rotline(x,y,18+ex,ex*2,s,c);
rotmove(x,y,4,-5+ex*0.2,s,c);rotline(x,y,18+ex*0.2,-ex,s,c);
rotmove(x,y,-10-ex*0.2,-10-ex,s,c);rotline(x,y,4-ex,-5-ex,s,c);
end;
end;
var x,y,dx,dy,kind:array[1..100] of integer;
a:integer;
angle,sx,sy,dsx,dsy,v2:real;
flame,oflame:real;
shotflag:boolean;
numshots:integer;
shf: array[1..5] of boolean;
shx,shy,shdx,shdy: array[1..5] of real;
shtime: array[1..5] of integer;
level,digit:integer;
oldtime:byte;
scoreflag,highflag,dead:boolean;
hypcount:integer;
Procedure miniship(h,v:integer); { Draws the ships-left ship }
begin
line(h+5,0,h,15);
line(h+5,0,h+10,15);
line(h+10,15,h+5,12);line(h+5,12,h,15);
end;
Procedure KillRock(r:integer); { Destroys a rock, creates small one }
var i:integer; { and throws in some dust }
begin
setcolor(0); DrawObject(kind[r],x[r] div 2,y[r] div 2);
If snd<4 then begin
snd:=3; time:=30;
end;
MakeDust(x[r] div 2,y[r] div 2);
kind[r]:=(kind[r]+1) and 3;
if kind[r]>0 then begin
i:=numrocks+1; numrocks:=i;
kind[i]:=kind[r]; x[i]:=x[r]; y[i]:=y[r];
dx[r]:=0; dy[r]:=0;
case kind[r] of
2:begin
while dx[r]=0 do dx[r]:=random(7)-3;
while dy[r]=0 do dy[r]:=random(7)-3;
end;
3:begin
while dx[r]=0 do dx[r]:=random(9)-5;
while dy[r]=0 do dy[r]:=random(9)-5;
end;
end;
dx[i]:=-dx[r];
dy[i]:=-dy[r];
end;
RocksLeft:=RocksLeft-1;
if RocksLeft=0 then level:=level+1;
end;
Procedure KillEnemy; { Destroys enemy ship/ makes dust }
begin
Setcolor(0);
DrawEnemy(Etype,Ex,Ey);
SND:=3;time:=20;
MakeDust(Ex-15,Ey+5);MakeDust(Ex-3,Ey-4);
MakeDust(Ex+6,Ey+9);MakeDust(Ex,Ey);
Ex:=700;
if RocksLeft<0 then RocksLeft:=-50;
Snd:=10;Time:=0;
end;
Function HitEnemy(h,v:integer):boolean;
var i,j:integer;
edead:boolean; { Checks for colision of enemy with the }
begin { point (h,v). }
edead:=false;
if Ecount>0 then begin
i:=h-Ex; j:=v-Ey;
case Etype of
1:if (abs(i)<21) and (abs(j)<11) then
if (i>=bsl[j+10]) and (i<=bsr[j+10]) then edead:=true;
2:if (abs(i)<15) and (abs(j)<6) then
if (i>=smsl[j+5]) and (i<=smsr[j+5]) then edead:=true;
end;
end;
HitEnemy:=edead;
end;
Function ColisionDetect(h,v:integer):integer;
var i,j,rock,cr:integer;
done:boolean; { Returns the number of the rock hit at (h,v) }
begin { or 0 if no rock hit }
done:=false;
rock:=1;
cr:=0;
while (rock<=numrocks) and (not done) do begin
if kind[rock]>0 then begin
i:=h-(x[rock] div 2); j:=v-(y[rock] div 2);
case kind[rock] of
1:if (abs(i)<31) and (abs(j)<36) then
if (i>=bl[j+35]) and (i<=br[j+35]) then begin
done:=true;
cr:=rock;
end;
2:if (abs(i)<21) and (abs(j)<22) then
if(i>=ml[j+20]) and (i<=mr[j+20]) then begin
done:=true;
cr:=rock;
end;
3:if (abs(i)<11) and (abs(j)<11) then
if(i>=sl[j+10]) and (i<=sr[j+10]) then begin
done:=true;
cr:=rock
end;
end;
end;
rock:=rock+1;
end;
ColisionDetect:=cr;
end;
Procedure HitShip; { Determines if the enemy bullet hits the player }
var i,j,t:real; { by rotating the point WRT the ship and comparing }
begin { with 2 lines. (don't ask) }
i:=sx-shx[5];j:=sy-shy[5];
if (abs(i)<20) and (abs(j)<20) then begin
t:=i;
i:=-scos*i+ssin*j;
j:=abs(ssin*t+scos*j);
if (j<(6.42857-0.35714*i)) and (j>(-2*i-10)) then begin
setcolor(0); DrawShip(sx,sy,flame);
boom:=1; dsx:=dsx*0.2; dsy:=dsy*0.2;
snd:=10;time:=0;
shtime[5]:=160;
end;
end;
end;
Procedure Shoot; { Handles player shots and a bunch more }
var s,c:real; { Should have broken this down more }
i,j,r:integer;
begin
if KBD.Down(fire) and (not shotflag) and
(numshots < 4) and (not NoShip) and (boom=0) then begin
if snd<3 then begin
snd:=2; freq:=10000; time:=15;
end;
a:=1;
while shf[a] do a:=a+1;
shx[a]:=sx+16*scos; shy[a]:=sy-16*ssin;
shdx[a]:=dsx+scos*2.5; shdy[a]:=dsy-ssin*2.5;
shtime[a]:=0; shf[a]:=true;
shotflag:=true;
numshots:=numshots+1;
end;
if not KBD.Down(fire) then shotflag:=false;
for a:=1 to 5 do
if shf[a] then begin
setcolor(0);
i:=round(shx[a]); J:=round(shy[a]);
line(i-1,j,i+1,j);
line(i,j-1,i,j+1);
shx[a]:=shx[a]+shdx[a]; shy[a]:=shy[a]+shdy[a];
if shx[a]<0 then shx[a]:=640
else if shx[a]>640 then shx[a]:=0;
if shy[a]<0 then shy[a]:=480
else if shy[a]>480 then shy[a]:=0;
shtime[a]:=shtime[a]+1;
if shtime[a]>110 then begin shf[a]:=false;if a<5 then
numshots:=numshots-1;end;
if shf[a] then begin
setcolor(15);
i:=round(shx[a]); J:=round(shy[a]);
line(i-1,j,i+1,j);
line(i,j-1,i,j+1);
r:=ColisionDetect(i,j);
if r>0 then begin
if a<5 then begin
case kind[r] of
1:score[6]:=score[6]+2; {add score for different size rox}
2:score[6]:=score[6]+5;
3:score[6]:=score[6]+9;
end;
i:=6;
while score[i]>9 do begin
score[i]:=score[i]-10;
if i>1 then begin i:=i-1; score[i]:=score[i]+1; end;
if i<4 then shipsleft:=shipsleft+1;
end;
end;
KillRock(r);
shtime[a]:=160;
end;
end;
if a<5 then begin
If HitEnemy(i,j) then begin
KillEnemy;
Score[5]:=Score[5]+Etype;
r:=5;
while (r>0) and (Score[r]>9) do begin
Score[r]:=Score[r]-10;
r:=r-1;
Score[r]:=Score[r]+1;
if r<4 then ShipsLeft:=ShipsLeft+1;
end;
shtime[a]:=160;
end;
end;
end;
if shf[5] and (boom=0) and not NoShip then HitShip;
end;
Procedure NewRocks; { Creates a new asteroid field }
begin
NumRocks:=4+(level div 2);
if NumRocks>8 then NumRocks:=8;
RocksLeft:=7*NumRocks;
Ecount:=-1000-200*NumRocks;
for a:=1 to 100 do begin
kind[a]:=0; if a<=NumRocks then begin
kind[a]:=1;
x[a]:=320; y[a]:=240;
while (x[a]>240) and (x[a]<1000) and (y[a]>160) and (y[a]<760) do
begin
x[a]:=random(1280);
y[a]:=random(960);
end;
dx[a]:=((a and 1)*2-1)*(((a-1) and 4)div 4 +1);
dy[a]:=(a and 2)-1;
end;
end;
end;
Procedure MoveRocks; { Updates the rocks for one frame }
begin
If RocksLeft > 0 then begin
for a:=1 to numrocks do begin
setcolor(0); { erase object }
drawobject(kind[a],x[a] div 2,y[a] div 2);
x[a]:=x[a]+dx[a]; { move object }
y[a]:=y[a]+dy[a];
if x[a] > 1310 then x[a]:=x[a]-1310; { horizontal wrap around }
if x[a] < -20 then x[a]:=x[a]+1310;
if y[a] >1000 then y[a]:=y[a]-1040; { vertical wrap around }
if y[a] <-20 then y[a]:=y[a]+1040;
if color then setcolor((a and 7)+1) else setcolor(15);
drawobject(kind[a],x[a] div 2,y[a] div 2); { draw in new position }
end;
end
else begin
RocksLeft:=RocksLeft-1;
If (RocksLeft<-200) and (Ecount<0) then NewRocks;
end;
end;
procedure MoveShip; { Handles player ship movement and more }
begin { This procedure got WAY out of hand :) }
if NoShip then begin
if hypcount=0 then begin
NoShip:=false;
sx:=320; sy:=240;
dsx:=0; dsy:=0; angle:=1.57;
ssin:=1; scos:=0;
flicker:=1;
if (Ecount>0) or shf[5] then NoShip:=True;
for a:=1 to numrocks do begin
if (kind[a]>0) then
if (x[a]<960) and (x[a]>320) and (y[a]<760) and (y[a]>220) then
NoShip:=true;
end;
if KBD.Down(plop) then NoShip:=false;
if not NoShip then begin
setcolor(0);
miniship(14*shipsleft,0);
Shipsleft:=ShipsLeft-1;
end;
end;
if hypcount>0 then begin { if ship is in hyperspace, hypcount }
hypcount:=hypcount-1; { will be greater than zero }
if hypcount=0 then begin {bring ship out of hyperspace}
sx:=random(600)+20; dsx:=0;
sy:=random(440)+20; dsy:=0;
flicker:=1;
noship:=false;
if Random(3)=0 then begin
boom:=1;
Snd:=10;time:=0;
end;
end;
end;
end
else begin
if (boom=0) and KBD.Down(thrust) then begin
dsx:=dsx+scos*0.05;
dsy:=dsy-ssin*0.05;
if flame < 10 then flame:=flame+0.5;
if snd=0 then begin snd:=1; time:=1; end;
end
else flame:=0;
V2:=(dsx*dsx+dsy*dsy)*0.0005;
dsx:=dsx*(0.997-v2);
dsy:=dsy*(0.997-v2);
setcolor(0);drawship(sx,sy,oflame);
if boom>0 then begin
boom:=boom+1;
if boom=120 then begin
boom:=0;
Noship:=true;
if shipsleft=0 then shipsleft:=-1;
end;
end;
If KBD.Down(rotleft) and (boom=0) then begin
angle:=angle+0.05;
if angle > 6.283185 then angle:=angle - 6.283185;
end;
if KBD.Down(rotright) and (boom=0) then begin
angle:=angle-0.05;
if angle < 0 then angle:=angle + 6.283185;
end;
ssin:=sin(angle); scos:=cos(angle);
sx:=sx+dsx; sy:=sy+dsy;
if sx > 660 then sx:=sx-680; { horizontal wrap around }
if sx < -20 then sx:=sx+680;
if sy >500 then sy:=sy-520; { vertical wrap around }
if sy <-20 then sy:=sy+520;
if not NoShip then begin
setcolor(15);drawship(sx,sy,flame);end;
oflame:=flame;
end;
end;
Procedure Crash; { Tests 5 points on the ship for colision with }
var i,j:integer; { Asteroids and enemy ships }
s,c:real;
begin
if (not NoShip) and (boom=0) then begin
dead:=false;
i:=round(sx-scos*10+ssin*10);
j:=round(sy+ssin*10+scos*10);
if ColisionDetect(i,j)>0 then dead:=true;
if HitEnemy(i,j) then begin
dead:=true;
KillEnemy;
end;
i:=round(sx+scos*4-ssin*5);
j:=round(sy-ssin*4-scos*5);
if ColisionDetect(i,j)>0 then dead:=true;
if HitEnemy(i,j) then begin
dead:=true;
KillEnemy;
end;
i:=round(sx+scos*4+ssin*5);
j:=round(sy-ssin*4+scos*5);
if ColisionDetect(i,j)>0 then dead:=true;
if HitEnemy(i,j) then begin
dead:=true;
KillEnemy;
end;
i:=round(sx-scos*10-ssin*10);
j:=round(sy+ssin*10-scos*10);
if ColisionDetect(i,j)>0 then dead:=true;
if HitEnemy(i,j) then begin
dead:=true;
KillEnemy;
end;
i:=round(sx+scos*18);
j:=round(sy-ssin*18);
if ColisionDetect(i,j)>0 then dead:=true;
if HitEnemy(i,j) then begin
KillEnemy;
dead:=true;
end;
if dead then begin
setcolor(0); DrawShip(sx,sy,flame);
boom:=1; dsx:=dsx*0.2; dsy:=dsy*0.2;
Snd:=10;time:=0;
end;
end;
end;
Procedure DisplayNumber(d,h,v:integer); { Displays a digit }
begin
setcolor(0);line(h,v,h+10,v);line(h,v,h,v+20);line(h+10,v,h+10,v+20);
line(h,v+10,h+10,v+10);line(h,v+20,h+10,v+20);
setcolor(15);
if (d=0) or (d=1) or (d=3) or (d=4) or (d>6) then
line(h+10,v,h+10,v+20);
if (d <> 1) and (d <> 4) then line(h,v,h+10,v);
if (d <> 0) and (d <> 1) and (d <> 7) then line(h,v+10,h+10,v+10);
if (d <> 1) and (d <> 4) and (d <> 7) then line(h,v+20,h+10,v+20);
if (d = 0) or (d = 6) or (d = 8) then line(h,v,h,v+20);
if d=2 then begin line(h+10,v,h+10,v+10);line(h,v+10,h,v+20);end;
if (d=4) or (d=5) or (d=6) or (d=9) then begin
line(h,v,h,v+10);line(h+10,v+10,h+10,v+20);end;
end;
Procedure EShoot; { Handles enemy fire }
var t:real;
begin
case Etype of
1:begin
shdx[5]:=0;shdy[5]:=0;
while (abs(shdx[5])+abs(shdy[5]))<2.5 do begin
shdx[5]:=random(40)/10-2;
shdy[5]:=random(40)/10-2;
end;
shtime[5]:=0;
shx[5]:=Ex+4*shdx[5];
shy[5]:=Ey+4*shdy[5];
shf[5]:=true;
end;
2:begin
t:=160;shdx[5]:=0;shdy[5]:=0;
while ((abs(shdx[5])+abs(shdy[5]))<3) and (t>10) do begin
t:=t-10;
shdx[5]:=(sx+dsx*t*0.9-Ex)/t;
shdy[5]:=(sy+dsy*t*0.9-Ey)/t;
end;
shx[5]:=Ex+2*shdx[5];
shy[5]:=Ey+2*shdy[5];
shtime[5]:=0;
shf[5]:=true;
end;
end;
end;
Procedure MoveEnemy; { Handles emeny movement }
var r:integer;
f:boolean;
begin
if Ecount<0 then Ecount:=Ecount+1;
if Ecount=0 then begin
f:=true;
for r:=1 to NumRocks do
if kind[r]>0 then
if ((x[r]<150) or (x[r]>500)) and (y[r]<Ey+80) and (y[r]>Ey-80)
then f:=false;
if f then begin
Ecount:=Ecount+1;
If Snd<7 then Snd:=6+Etype;
end;
end;
if Ecount>0 then begin
if (Ex and 127)= 63 then EShoot;
SetColor(0);DrawEnemy(Etype,Ex,Ey); {moveship}
Ex:=Ex+Edx;Ey:=Ey+Edy;
SetColor(15);DrawEnemy(Etype,Ex,Ey);
If (Ey>460) or (Ey<20) then Edy:=0; {Check Vertical bounds}
If Random(100)=4 then begin {Make course change}
Edy:=random(3)-1;
if Ey>400 then Edy:=-1;
if Ey<80 then Edy:=1;
end;
If (Ex>660) or (Ex<-20) then begin
if Snd<9 then Snd:=0;
Ecount:=-600-Random(500);
Etype:=1;
if random(3+level)>3 then Etype:=2;
Ey:=random(400)+40;
Edy:=random(3)-1;
Ex:=600;Edx:=-1;
if random(2)=0 then begin
Ex:=-20;Edx:=1;
end;
end;
end;
end;
Procedure CrashEnemy; { Checks for enemy/rock colisions }
begin
if Etype=1 then
If (ColisionDetect(Ex-20,Ey-1)>0) or (ColisionDetect(Ex+20,Ey-1)>0)
or (ColisionDetect(Ex-12,Ey+10)>0) or (ColisionDetect(Ex+12,Ey+10)>0)
or (ColisionDetect(Ex-5,Ey-10)>0) or (ColisionDetect(Ex+5,Ey-10)>0)
then KillEnemy;
if Etype=2 then
If (ColisionDetect(Ex-10,Ey-1)>0) or (ColisionDetect(Ex+10,Ey-1)>0)
or (ColisionDetect(Ex-6,Ey+5)>0) or (ColisionDetect(Ex+6,Ey+5)>0)
or (ColisionDetect(Ex-2,Ey-5)>0) or (ColisionDetect(Ex+2,Ey-5)>0)
then KillEnemy;
end;
Procedure StartScreen; { Displays the startup screen }
var h,c,l:word;
begin
ClearDevice;
setcolor(15);
moveto(110,160);lineto(110,60);lineto(170,60);lineto(170,110);
lineto(110,110);moveto(140,110);lineto(170,160);
moveto(200,60);lineto(260,60);lineto(260,160);lineto(200,160);
lineto(200,60);
moveto(350,60);lineto(290,60);lineto(290,160);lineto(350,160);
moveto(380,60);lineto(380,160);moveto(380,110);lineto(410,110);
lineto(440,60);moveto(410,110);lineto(440,160);
moveto(530,60);lineto(470,60);lineto(470,110);lineto(530,110);
lineto(530,160);lineto(470,160);
DisplayString('copyright',261,220);
DisplayString('by',309,280);
h:=230;c:=15;
for l:=1 to 4 do begin { A crude way to encode my }
DrawLetter(chr(c+ord('a')),h,310); { name so it doesn't appear }
h:=h+14; { in the .exe file. }
c:=(c*34+20) mod 53;
end;
h:=328;c:=10;
for l:=1 to 4 do begin
DrawLetter(chr(c+ord('a')),h,310);
h:=h+14;
c:=(c*26+7) mod 89;
end;
DisplayString('h er',300,310);
DisplayNumber(1,287,250);DisplayNumber(9,303,250);
DisplayNumber(9,317,250);DisplayNumber(3,331,250);
DisplayString('f for help',244,450); DisplayNumber(1,254,450);
mem[$0040:$006c]:=0;
while mem[$0040:$006c]<80 do ;
end;
Procedure ShowScores; { Only one digit of each score is displayed each }
begin { frame. Don't need rapid update }
Digit:=Digit+1;if digit=8 then begin
digit:=1;scoreflag:=false;highflag:=false;end;
if (score[digit]>0) or (digit=7) then scoreflag:=true;
if (high[digit]>0) or (digit=7) then highflag:=true;
if scoreflag then DisplayNumber(Score[digit],480+digit*14,0);
if highflag then DisplayNumber(high[digit],220+digit*14,0);
if shipsleft>=digit then begin
setcolor(15); miniship(14*digit,0); end;
end;
Procedure PlaySound; { This procedure is responsible for creating all }
var tone:word; { the cheap sound effects. I should have made a }
begin { Startsound procedure too to keep things nice }
if KBD.Down(kS) then begin
if prvs then soundflag:=not soundflag;
if not soundflag then nosound;
snd:=0;
prvs:=false;
end
else prvs:=true;
if soundflag then
case snd of
0:NoSound;
1:begin
if time=0 then begin
NoSound; snd:=0; end
else begin
time:=0;
if random(5)=0 then NoSound
else Sound(Random(50)+60);
end;
end;
2:begin
if time=0 then begin
NoSound; snd:=0; end
else begin
time:=time-1;
tone:=round(freq);
sound(tone);
freq:=(freq*0.7);
end;
end;
3:begin
if time=0 then begin
NoSound; snd:=0; end
else begin
time:=time-1;
sound(random(70+time));
end;
end;
7:begin
freq:=freq*1.05;
if freq>3500 then freq:=1500;
tone:=round(freq);
sound(tone);
end;
8:begin
freq:=freq*1.1;
if freq>5000 then freq:=2500;
tone:=round(freq);
sound(tone);
end;
10:begin
if time<100 then begin
time:=time+1;
if random(10)=0 then NoSound
else
sound(random(200-time))
end
else begin snd:=0; nosound; end;
end;
end;
end;
Procedure LoadOptions; { Loads the saved settings (mostly key values) }
var f:text;
c:integer;
begin
assign(f,'rockdata');
reset(f);
readln(f,rotleft);
readln(f,rotright);
readln(f,fire);
readln(f,thrust);
readln(f,hyper);
readln(f,plop);
readln(f,newgame);
readln(f,maxships);
readln(f,c);
close(f);
color:=false;
if c=1 then color:=true;
end;
Procedure SaveOptions; { Saves the options }
var f:text;
begin
Port[$43] := $43; {restore normal timer frequency}
Port[$40] := 0; {this has to be done to read/write disks}
Port[$40] := 0;
setcolor(15);
DisplayString('saving',264,380);
oldtime:=mem[$0040:$006c]; {wait for clock to be normal}
while mem[$0040:$006c]=oldtime do ;
assign(f,'rockdata');
rewrite(f);
writeln(f,rotleft);
writeln(f,rotright);
writeln(f,fire);
writeln(f,thrust);
writeln(f,hyper);
writeln(f,plop);
writeln(f,newgame);
writeln(f,maxships);
if color then writeln(f,1)
else writeln(f,0);
close(f);
mem[$0040:$006c]:=0;
while mem[$0040:$006c]<90 do ;
setcolor(0);
DisplayString('saving',264,380);
Port[$21]:=Port[$21] and $FE; {alter interupt freq again}
Port[$43]:=$43;
Port[$40]:=0;
Port[$40]:=60;
end;
Function WhichKey:byte; { Waits for a keypress. I think this is the }
var k:byte; { cause of the help-screen lockup bug. I think }
begin { some of the invalid codes get set to Down }
k:=0; {and never go up (since they aren't really keys)}
while not KBD.Down(k) do begin { If you find a simple fix, let me know}
k:=k+1;
if k=160 then k:=176;
if k=128 then k:=144;
if k=240 then k:=0;
end;
while KBD.Down(k) do ;
WhichKey:=k;
end;
Function GetDef(functn:string):byte; { Waits for user to select a key for }
begin { various functions }
Setcolor(15);
DisplayString(functn,325,380);
GetDef:=WhichKey;
Setcolor(0);
DisplayString(functn,325,380);
end;
Procedure DefineKeys; { Prompts player for each key }
begin
Setcolor(4);
DisplayString('choose key to',130,380);
fire:=Getdef('fire');
thrust:=Getdef('thrust');
rotleft:=Getdef('rotate left');
rotright:=Getdef('rotate right');
hyper:=Getdef('hyperspace');
plop:=Getdef('force next ship');
newgame:=Getdef('start new game');
SetColor(0);
DisplayString('choose key to',130,380);
end;
Procedure Help; { Displays the help screen }
var k:byte;
temps,tempc:real;
begin
NoSound;
ClearDevice;
SetColor(15);
DisplayString('rocks help screen',194,0);
SetColor(1);
DisplayString('while playing press',180,40);
SetColor(4);
DisplayString('b for black and white',180,70);
DisplayString('c for color',180,100);
DisplayString('s to toggle sound',180,130);
SetColor(2);
DisplayString('plus or minus to change ships per game',54,260);
SetColor(7);
DisplayString('press r to redefine ship controls',96,290);
DisplayString('s to save settings',180,320);
Setcolor(6);
DisplayString(' escape to exit help screen',96,455);
repeat
temps:=ssin;tempc:=scos;
ssin:=1;scos:=0;
For k:=1 to 8 do begin
Setcolor(15);
if k>maxships then SetColor(0);
DrawShip(180+30*k,210,0);
end;
ssin:=temps;scos:=tempc;
k:=WhichKey;
if (k=12) and (maxships>1) then maxships:=maxships-1;
if (k=13) then maxships:=maxships+1;
if k=19 then DefineKeys;
if k=31 then SaveOptions;
until k=1;
ClearDevice;
end;
begin {main}
{Initialize}
LoadTables;
LoadOptions;
for a:=1 to 7 do high[a]:=0; {clear high score}
INITIALIZE;
SetPalette;
StartScreen;
KBD.INIT;
MaxShips:=4;
numd:=0;
for a:=0 to 63 do dustcount[a]:=20;
Randomize;
Port[$21]:=Port[$21] and $FE; {alter interupt freq}
Port[$43]:=$43; { The timer frequency is changed and used }
Port[$40]:=0; { as a speed limiter }
Port[$40]:=60;
soundflag:=false;
repeat
{begin game}
ClearDevice;
NoSound; Snd:=0;
ssin:=1;scos:=0;
dsx:=0; dsy:=0; flame:=0; oflame:=0; flicker:=1; boom:=0;
hypcount:=0;
for a:=1 to 5 do begin
shx[a]:=0;shy[a]:=0;shdx[a]:=0;shdy[a]:=0;
shf[a]:=false;
shtime[a]:=0;
end;
numshots:=0;
level:=1;
shipsleft:=MaxShips;
for a:=1 to 7 do score[a]:=0;
digit:=0; scoreflag:=false; highflag:=false;
numrocks:=-100;
RocksLeft:=0;
NoShip:=true;
Ex:=700;Edx:=1;Ey:=99;Edy:=1;Etype:=1;
Ecount:=-1000;
{********** MAIN GAME LOOP ***********}
repeat
if KBD.Down(kC) then color:=true;
if KBD.Down(kB) then color:=false;
if KBD.Down(hyper) and (boom=0) and (not NoShip) then begin
SetColor(0);
DrawShip(sx,sy,flame);
hypcount:=50;
NoShip:=True;
end;
Moverocks;
MoveShip;
MoveEnemy;
Shoot;
Crash;
If Ecount>0 then CrashEnemy;
MoveDust;
ShowScores;
PlaySound;
while mem[$0040:$006c]=oldtime do ; { wait for clock tick }
oldtime:=mem[$0040:$006c];
if KBD.Down(kF1) then Help;
until KBD.Down(kESC) or ((shipsleft<0) and (boom=0));
NoSound;
repeat { post-game loop to keep display active }
a:=1;
while (high[a]=score[a]) and (a<7) do a:=a+1;
if score[a]>high[a] then begin
for a:=1 to 7 do high[a]:=score[a];
end;
MoveRocks;
Showscores;
MoveEnemy;
If Ecount>0 then CrashEnemy;
Shoot;
MoveDust;
if KBD.Down(kF1) then Help;
while mem[$0040:$006c]=oldtime do ;
oldtime:=mem[$0040:$006c];
until KBD.Down(newgame) or KBD.Down(kESC);
until KBD.Down(kESC);
KBD.Done;
closegraph;
Port[$43] := $43; {restore normal timer frequency}
Port[$40] := 0;
Port[$40] := 0;
end.